/*
    This file is part of the substandard lisp implementation of Standard Lisp
    Copyright (C) 2011 Nicky Nickell

    substandard lisp is free software: you can redistribute it and/or modify
    it under the terms of the GNU General Public License as published by
    the Free Software Foundation, either version 3 of the License, or
    (at your option) any later version.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU General Public License for more details.

    You should have received a copy of the GNU General Public License
    along with this program.  If not, see <http://www.gnu.org/licenses/>.
*/

function std_prog(a, env) {
  var vars = a[0];
  var program = a[1];

  var retval = NIL;
  var err = UNDEFINED;

  env.variables = env.variables.inner_block();
  for (var p = vars; p != NIL; p = p.cdr) {
    env.variables._set(p.car.value, NIL);
  }

  try {
    for (var i = 0; i < program.length; i++) {
      try {
        program[i].evaluate(env);
      } catch (e) {
        if (e.type == ERROR_GO) {
          for (var j = 0; j < program.length; j++) {
            if (program[j] == e.value) {
              i = j++;
              break;
            }
          }
        } else {
          throw e;
        }
      }
    }
  } catch (e) {
    if (e.type == ERROR_RETURN) {
      retval = e.value;
    } else {
      err = e;
    }
  } finally {
    env.variables = env.variables.outer;
    if (err != UNDEFINED) {
      throw err;
    } else {
      return retval
    }
  }
}

/*---
name: prog
arity: 1
rest: true
ftype: FTYPE_FEXPR

argument-types:
  - TYPE_PAIR | TYPE_BOOLEAN
  - CLASS_ANY

doc: |
  explaining what prog is / how it is used!

tests: |
  (prog () (return 1)) -> 1
  (prog NIL (return 1)) -> 1
  (prog NIL 1 2 3) -> NIL
  (prog NIL (go a) a (return 1)) -> 1
  (prog NIL (go a) (return 1) a (return 2)) -> 2
  (prog NIL (go b) a (return 1) b (go a)) -> 1
...*/
